
 1000  *SAVE S.POLYCOL 
 1010  *--------------------------------
 1020  *  PolyCol
 1030  *  Produces multi-column Apple monitor dis-assemblies.
 1040  *  Copyright (c) 1986 Adam Levin
 1050  *--------------------------------
 1060         .OR $800     
 1070  *---User parameters--------------
 1080  STRTL  .EQ $00      Starting address
 1090  STRTH  .EQ $01 
 1100  ENDL   .EQ $02      Ending address
 1110  ENDH   .EQ $03
 1120  NCPP   .EQ $04      # Columns per page
 1130  *                     (0 <= NCPP <= FF) 
 1140  *                     (each column takes 34 chars.)
 1150  NLPP   .EQ $05      # Lines printed per page
 1160  *                     (0 <= NLPP <= FF)
 1170  NSKP   .EQ $06      # Blank lines between pages
 1180  *                     (0 <= NSKP <= FF) 
 1190  *                     (FF = Form feed)
 1200  *                     (FE = pause between pages)
 1210  SLOT   .EQ $07      Slot # to direct output to
 1220  *                     (0 <= SLOT <= 7)
 1230  *                     (0 = use currently active device)
 1240  *---Program variables------------
 1250  BRUNFX .EQ $08      Holds the DOS stack pointer
 1260  TOFARL .EQ $09      Adrs of 1st opcode in col 2;
 1270  TOFARH .EQ $0A      1st column ends just before it.
 1280  TCSWL  .EQ $0B      Holds the 'other' CSWL address
 1290  TCSWH  .EQ $0C  
 1300  COLCNT .EQ $0D      Current column    
 1310  TEMPL  .EQ $0E      Temporary storage
 1320  TEMPH  .EQ $0F          "        "
 1330  *---Monitor variables-------------
 1340  FORMAT .EQ $2E      Holds addressing mode code
 1350  CSWL   .EQ $36      Character Output SWitch Low address
 1360  CSWH   .EQ $37          "       "      "    High   "
 1370  PCL    .EQ $3A      Adrs of opcode currently being
 1380  PCH    .EQ $3B      dis-assembled.
 1390  STKPTR .EQ $AA59    DOS 3.3 stack pointer save loc't'n
 1400  KBD    .EQ $C000    Keyboard
 1410  STROBE .EQ $C010    Clear keyboard strobe
 1420  *---Monitor ROM Subroutines------
 1430  INSDS2 .EQ $F88C    Formats each disassembly line
 1440  INSTDSPA .EQ $F8D3  Print opcode & operand
 1450  PRBL2  .EQ $F94A    Prints (X-reg) many blank spaces
 1460  PCADJ  .EQ $F953    Adjusts A,Y (PCL,H) after each line
 1470  RDKEY  .EQ $FD0C    Get an input character
 1480  CROUT  .EQ $FD8E    Print a <RETURN>
 1490  PRYX2A .EQ $FD99    Print 'adrs-'
 1500  COUT   .EQ $FDED    Print Acc as a character
 1510  *---Macro definitions------------
 1520         .MA CMPD     Double byte CMP
 1530         LDA ]1       From the S-C      
 1540         CMP ]2       MACRO LIBRARY file.
 1550         LDA ]1+1
 1560         SBC ]2+1
 1570         .EM
 1580  *
 1590         .MA MOVD     Double byte MOV
 1600         LDA ]1
 1610         STA ]2
 1620         LDA ]1+1
 1630         LDA ]2+1
 1640         .EM
 1650  *
 1660         .MA MSG      MESSAGE PRINT MACRO
 1670         LDX #]1
 1680         JSR PRINT.MESSAGE
 1690         .EM
 1700  *---------------------------------
 1710  POLYCOL
 1720         LDA STKPTR   Save stack pointer now,
 1730         STA BRUNFX   restore it at the end.
 1740         LDA SLOT     Send the output to another device?
 1750         BEQ .1       No. 
 1760         ORA #$C0     Use $Cn00 (n=SLOT) so we can simulate a
 1770         LDX #0       PR#n when we swap CSWL,H & TCSWL,H.
 1780         BEQ .2       This creates a problem if SLOT <> 0 &  
 1790  .1     LDA CSWH     SLOT contains an 80-col card since PR# 
 1800         LDX CSWL     can activate card, but not de-activate.
 1810  .2     STA TCSWH    No harm done, but it can be confusing.
 1820         STX TCSWL
 1830         JMP PAUSE2   Start out by waiting for a keypress.
 1840  *--------------------------------
 1850  STRT   LDA NLPP     'CALC' NLPP lines from STRTL,H.
 1860         STA TEMPL    Adrs of the opcode just after the last
 1870         LDA #0       one in column one.  Store in TOFARL,H
 1880         STA TEMPH    to keep STRTL,H from going beyond it.
 1890         JSR CALC
 1900         >MOVD PCL,TOFARL
 1910  COLM1  LDA #1       Always start in column one.
 1920         STA COLCNT   Set COLCNT to 1 
 1930         >CMPD ENDL,STRTL   Have we finished?
 1940         BCS NOESC    No, ENDL,H >= STRTL,H
 1950         JSR CROUT    Yes, purge last printed line. 
 1960  ESC    JSR SWAP     <ESC> brings you here, too.
 1970         >MSG M.BYE   Print end message.
 1980         LDA BRUNFX   Restore the stack pointer
 1990         STA STKPTR                    
 2000         RTS          All done.
 2010  NOESC  >CMPD STRTL,TOFARL  About to pass col 2?
 2020         BCC NULINE   No, so continue
 2030         LDX NCPP     Yes, so find the new first
 2040         JSR MULT     line for the new first column.
 2050         JSR CALC
 2060         >MOVD PCL,STRTL
 2070  NUPAGE LDX NSKP     Page breaks
 2080         CPX #$FE
 2090         BEQ PAUSE    Pause 
 2100         BCS FRMFD    Form feed
 2110         CPX #0  
 2120  .1     BEQ STRT     No break - solid listing
 2130         JSR CROUT    Yes, print NSKP lines 
 2140         DEX  
 2150         JMP .1
 2160  *--------------------------------
 2170  FRMFD  LDA #$8C
 2180         JSR COUT
 2190         JMP STRT
 2200  *--------------------------------
 2210  PAUSE  JSR CROUT    Print a <RETURN>
 2220         JSR SWAP     Swap TCSWL,H & CSWL
 2230  PAUSE2 >MSG M.PAUSE Print PAUSE msg
 2240         JSR RDKEY
 2250         JSR SWAP     Swap back
 2260         JMP STRT     Do it all again
 2270  *--------------------------------
 2280  NULINE JSR CROUT    Print a <RETURN>
 2290         LDA KBD      A key might have been pressed
 2300         EOR #$9B     It might have been <ESC>
 2310         BNE OFFSET   It wasn't; continue 
 2320         BIT STROBE   It was!  ESCape!
 2330         JMP ESC
 2340  OFFSET LDX COLCNT   Compute which opcode to
 2350         JSR MULT     Disassemble next.
 2360         JSR CALC
 2370         >CMPD ENDL,PCL  Is adrs be beyond ENDL,H?
 2380         BCC NEXTOP   Yes, don't bother with it
 2390         LDX PCL      No, so disassemble it
 2400         LDY PCH
 2410         JSR PRYX2A   Print the opcode address
 2420         LDX #1  
 2430         JSR PRBL2    Print 1 blank.  Monitor puts three
 2440  *                   here, but if each column is no more
 2450  *                   than 34 chars long, can fit 4 columns
 2460  *                   onto a printer with 132 chars/line.
 2470         JSR INSDS2   Format it
 2480         JSR INSTDSPA   Print it
 2490         LDA COLCNT   If last column, don't pad.
 2500         CMP NCPP 
 2510         BEQ NXTCOL   It is, get out
 2520         LDX #0       Isn't, so pad with blanks so that each
 2530  *                   column takes exactly 34 characters.
 2540         JSR INSDS2   Calculate the format code
 2550         LDX #10      ASSUME 10 SPACES
 2560         LDA FORMAT   Get it
 2570         BEQ SPACE    1 byte code requires 10 spaces
 2580         LDX #7       ASSUME 7 SPACES
 2590         CMP #$81     Z-page
 2600         BEQ SPACE    
 2610         DEX          ASSUME 6 SPACES
 2620         CMP #$21     Immediate
 2630         BEQ SPACE
 2640         DEX          ASSUME 5 SPACES
 2650         CMP #$82     Absolute
 2660         BEQ SPACE    5 SPACES
 2670         CMP #$85     Zpage,Y
 2680         BEQ SPACE    5 SPACES
 2690         CMP #$91     Zpage,X
 2700         BEQ SPACE    5 SPACES
 2710         CMP #$9D     Relative
 2720         BEQ SPACE    5 SPACES
 2730         LDX #3       All others
 2740  SPACE  JSR PRBL2    Print (X-reg) many blanks
 2750  NXTCOL INC COLCNT   Go to next column
 2760         LDA NCPP
 2770         CMP COLCNT   Have we gone too far?
 2780         BCS OFFSET   No, do OFFSET  
 2790  NEXTOP LDA #1       Jump over the line
 2800         STA TEMPL    just done.
 2810         LDA #0  
 2820         STA TEMPH
 2830         JSR CALC
 2840         >MOVD PCL,STRTL    Store it in STRTL,H
 2850         JMP COLM1    And do it all again
 2860  *---------------------------------
 2870  *  CALC returns the opcode adrs that is TEMPL,H
 2880  *       disassembled (!) lines from STRTL,H
 2890  *       It returns this address in PCL,H
 2900  CALC   >MOVD STRTL,PCL   Put STRTL,H into PCL,H for INSDS1 
 2910  .1     LDA TEMPL    If TEMPL,H = 0 then done
 2920         ORA TEMPH
 2930         BEQ .3    
 2940         LDX #0   
 2950         JSR INSDS2   Get end of the next opcode & operand
 2960         JSR PCADJ    Get the new address from PCADJ
 2970         STA PCL      Store the resulting address in PCL,H
 2980         STY PCH
 2990         LDA TEMPL    DEC TEMPL,H - with help
 3000         BNE .2       from the MACRO LIBRARY again!
 3010         DEC TEMPH
 3020  .2     DEC TEMPL
 3030         CLV          Exit from top of loop, not here
 3040         BVC .1       Always taken
 3050  .3     RTS
 3060  *--------------------------------
 3070  *  MULT returns (NLPP * n-1).  N is usually
 3080  *       COLCNT, and as such is usually a small
 3090  *       number (almost always smaller than NLPP). 
 3100  *       So MULT simply adds NLPP to itself n times.
 3110  *       Returns with result in TEMPL,H
 3120  MULT   LDA #0       Zero TEMPL,H 
 3130         STA TEMPL
 3140         STA TEMPH
 3150  .1     CLC
 3160  .2     DEX          Exit loop from top, so call with n+1
 3170         BEQ .3       Anything times 0 equals 0
 3180         LDA TEMPL    Add NLPP to TEMPL,H
 3190         ADC NLPP
 3200         STA TEMPL
 3210         BCC .1       ...NO CARRY, KEEP ADDING
 3220         INC TEMPH    ...CARRY
 3230         BCS .1       ...ALWAYS
 3240  .3     RTS
 3250  *--------------------------------
 3260  SWAP   LDA CSWL     Swap output device adrses.  They are
 3270         LDX TCSWL    the same if SLOT = 0, but swap anyway.
 3280         STX CSWL     
 3290         STA TCSWL
 3300         LDA CSWH
 3310         LDX TCSWH
 3320         STX CSWH
 3330         STA TCSWH
 3340         RTS
 3350  *--------------------------------
 3360  PM.1   JSR COUT
 3370         INX
 3380  PRINT.MESSAGE
 3390         LDA MSGS,X
 3400         BMI PM.1
 3410         RTS
 3420  *--------------------------------
 3430  MSGS
 3440  M.PAUSE    .EQ *-MSGS
 3450         .AT -'PRESS A KEY '   
 3460  M.BYE      .EQ *-MSGS
 3470         .AT -'*** END OF LISTING '
 3480  *--------------------------------

